***                                                                                                                                                                                                                                                       
***                                                                                                                                                                                                                                                       
*** This Program already converted to Y2K                                                                                                                                                                                                                 
*** S&T Departement     on 29 April 1999 by Ben.Rahman                                                                                                                                                                                                    
***                                                                                                                                                                                                                                                       
***                                                                                                                                                                                                                                                       
set cent on                                                                                                                                                                                                                                               
SET DEVI TO PRINT                                                                                                                                                                                                                                         
STORE 0 TO TOTMED,TOTPHR,TOTALL                                                                                                                                                                                                                           
a=year(date())                                                                                                                                                                                                                                            
* a=substr(str(a,4),3,2)                                                                                                                                                                                                                                    
mstop = .f.                                                                                                                                                                                                                                               
BR=15                                                                                                                                                                                                                                                     
page = 0                                                                                                                                                                                                                                                  
BB = 3                                                                                                                                                                                                                                                    
AA = 2                                                                                                                                                                                                                                                    
SELE 3                                                                                                                                                                                                                                                    
f3='ph'+kdpat                                                                                                                                                                                                                                             
use &dr&f3                                                                                                                                                                                                                                                
n1=reccount()                                                                                                                                                                                                                                             
l1 = reccount()/11                                                                                                                                                                                                                                        
lx1= int(l1)                                                                                                                                                                                                                                              
GO TOP                                                                                                                                                                                                                                                    
SELE 1                                                                                                                                                                                                                                                    
n2=reccount()                                                                                                                                                                                                                                             
l2 = reccount()/12                                                                                                                                                                                                                                        
lx2= int(l2)                                                                                                                                                                                                                                              
GO TOP                                                                                                                                                                                                                                                    
if l1 > l2                                                                                                                                                                                                                                                
   IF LX1 = 0                                                                                                                                                                                                                                             
      tot_pg = 1                                                                                                                                                                                                                                          
   ELSE                                                                                                                                                                                                                                                   
      if MOD(n1,5)#0                                                                                                                                                                                                                                      
         tot_pg = lx1+1                                                                                                                                                                                                                                   
      else                                                                                                                                                                                                                                                
         tot_pg = lx1                                                                                                                                                                                                                                     
      endif                                                                                                                                                                                                                                               
   ENDIF                                                                                                                                                                                                                                                  
else                                                                                                                                                                                                                                                      
   IF LX2 = 0                                                                                                                                                                                                                                             
      tot_pg = 1                                                                                                                                                                                                                                          
   ELSE                                                                                                                                                                                                                                                   
      if MOD(n2,8)#0                                                                                                                                                                                                                                      
         tot_pg = lx2+1                                                                                                                                                                                                                                   
      else                                                                                                                                                                                                                                                
         tot_pg = lx2                                                                                                                                                                                                                                     
      endif                                                                                                                                                                                                                                               
   ENDIF                                                                                                                                                                                                                                                  
endif                                                                                                                                                                                                                                                     
CT=0                                                                                                                                                                                                                                                      
DO While !mstop                                                                                                                                                                                                                                           
   CT=CT+1                                                                                                                                                                                                                                                
   nCntr = 0                                                                                                                                                                                                                                              
   F6 = 'CTRPRN'                                                                                                                                                                                                                                          
   SELE 6                                                                                                                                                                                                                                                 
   SET EXCLU OFF                                                                                                                                                                                                                                          
   USE &DR&F6                                                                                                                                                                                                                                             
   nCntr = CNTR+1                                                                                                                                                                                                                                         
   IF REC_LOCK()                                                                                                                                                                                                                                          
      REPL CNTR WITH nCntr                                                                                                                                                                                                                                
   ENDIF                                                                                                                                                                                                                                                  
   sele 1                                                                                                                                                                                                                                                 
   IF CT=1                                                                                                                                                                                                                                                
      DO CASE                                                                                                                                                                                                                                             
      CASE NCNTR<10                                                                                                                                                                                                                                       
         NOFT='0000'+STR(NCNTR,1)                                                                                                                                                                                                                         
      CASE NCNTR<100                                                                                                                                                                                                                                      
         NOFT= '000'+STR(NCNTR,2)                                                                                                                                                                                                                         
      CASE NCNTR<1000                                                                                                                                                                                                                                     
         NOFT='00'+STR(NCNTR,3)                                                                                                                                                                                                                           
      case Ncntr<10000                                                                                                                                                                                                                                    
         NOFT='0'+STR(NCNTR,4)                                                                                                                                                                                                                            
      OTHER                                                                                                                                                                                                                                               
         noft=str(Ncntr,5)                                                                                                                                                                                                                                
      ENDCASE                                                                                                                                                                                                                                             
   ENDIF                                                                                                                                                                                                                                                  
                                                                                                                                                                                                                                                          
   mstop = .t.                                                                                                                                                                                                                                            
   do heading                                                                                                                                                                                                                                             
   sele 1                                                                                                                                                                                                                                                 
   DO WHILE !EOF()                                                                                                                                                                                                                                        
      IF BR>25                                                                                                                                                                                                                                            
         MSTOP=.F.                                                                                                                                                                                                                                        
         EXIT                                                                                                                                                                                                                                             
      ENDIF                                                                                                                                                                                                                                               
      KDSH=AREA_CODE+SUB_AREACO+PRO_CODE                                                                                                                                                                                                                  
      @ BR,2 SAY KDSH                                                                                                                                                                                                                                     
      @ BR,09 SAY SHRT_DESCR                                                                                                                                                                                                                              
      IF AREA_CODE<>'E'                                                                                                                                                                                                                                   
	 @ BR,37 SAY DOC_CODE                                                                                                                                                                                                                                    
	 @ BR,44 SAY DOC_ALIAS                                                                                                                                                                                                                                   
      ENDIF                                                                                                                                                                                                                                               
      @ BR,55 SAY PROC_X                                                                                                                                                                                                                                  
*      @ BR,56 SAY PUB_PRICE                                                                                                                                                                                                                              
      PROPAY=PROC_PAY                                                                                                                                                                                                                                     
      DO SAYG WITH BR,70,PROPAY,'99,999.99','9,999,999'                                                                                                                                                                                                   
      TOTMED=TOTMED+PROC_PAY                                                                                                                                                                                                                              
      TOTALL=TOTALL+PROC_PAY                                                                                                                                                                                                                              
      sele 1                                                                                                                                                                                                                                              
      SKIP                                                                                                                                                                                                                                                
      BR=BR+1                                                                                                                                                                                                                                             
   ENDDO                                                                                                                                                                                                                                                  
   serv=totmed*10/100                                                                                                                                                                                                                                     
   gtotmed=totmed+serv                                                                                                                                                                                                                                    
   DO SAYG WITH 26,70,totmed,'99,999.99','9,999,999'                                                                                                                                                                                                      
   DO SAYG WITH 27,70,serv,'99,999.99','9,999,999'                                                                                                                                                                                                        
   DO SAYG WITH 28,70,gtotmed,'99,999.99','9,999,999'                                                                                                                                                                                                     
   BR=32                                                                                                                                                                                                                                                  
   sele 3                                                                                                                                                                                                                                                 
   DO WHILE !EOF()                                                                                                                                                                                                                                        
      IF BR>48                                                                                                                                                                                                                                            
         SELE 3                                                                                                                                                                                                                                           
         MSTOP=.F.                                                                                                                                                                                                                                        
         EXIT                                                                                                                                                                                                                                             
      ENDIF                                                                                                                                                                                                                                               
      KDTEMP=PHAR_CODE                                                                                                                                                                                                                                    
      PAYTMP=PHAR_PAY                                                                                                                                                                                                                                     
      XTEM=PHAR_X                                                                                                                                                                                                                                         
      @ BR,2 SAY KDTEMP                                                                                                                                                                                                                                   
      @ BR,9 SAY RTRIM(PHAR_NAME)+' '+RTRIM(PHAR_TYPE)+' '+rtrim(PHAR_QANT)                                                                                                                                                                               
      @ br,38 say PHAR_UNIT                                                                                                                                                                                                                               
      @ BR,49 SAY PHAR_X                                                                                                                                                                                                                                  
      @ BR,54 SAY SALE_PRICE                                                                                                                                                                                                                              
      PHAPAY=PHAR_PAY                                                                                                                                                                                                                                     
      DO SAYG WITH BR,70,PHAPAY,'99,999.99','9,999,999'                                                                                                                                                                                                   
                                                                                                                                                                                                                                                          
*      @ BR,2 SAY KDTEMP                                                                                                                                                                                                                                  
*      @ BR,9 SAY RTRIM(PHAR_NAME)+'  '+RTRIM(PHAR_TYPE)+'  '+rtrim(PHAR_QANT)+'  '+PHAR_UNIT                                                                                                                                                             
*      @ BR,49 SAY PHAR_X                                                                                                                                                                                                                                 
*      WSALPRIC=SALE_PRICE                                                                                                                                                                                                                                
*      DO SAYG WITH BR,54,WSALPRIC,'9,999.99','999,999'                                                                                                                                                                                                   
*      PHAPAY=PHAR_PAY                                                                                                                                                                                                                                    
*      DO SAYG WITH BR,70,PHAPAY,'99,999.99','9,999,999'                                                                                                                                                                                                  
                                                                                                                                                                                                                                                          
      F10='DRUGS'                                                                                                                                                                                                                                         
      SELE 10                                                                                                                                                                                                                                             
      USE &DR&F10 INDEX &DR&F10                                                                                                                                                                                                                           
      SEEK KDTEMP                                                                                                                                                                                                                                         
      IF .NOT. EOF()                                                                                                                                                                                                                                      
         IF REC_LOCK(0)                                                                                                                                                                                                                                   
            REPL ST_ACT_TOT WITH ST_ACT_TOT-XTEM                                                                                                                                                                                                          
            REPL ST_ACT_BUY WITH INT(ST_ACT_TOT/BUY_SELL_R)                                                                                                                                                                                               
            REPL ST_ACT_SEL WITH ST_ACT_TOT-(ST_ACT_BUY*BUY_SELL_R)                                                                                                                                                                                       
         ENDIF                                                                                                                                                                                                                                            
         UNLOCK                                                                                                                                                                                                                                           
      ELSE                                                                                                                                                                                                                                                
         F10='DISPOS'                                                                                                                                                                                                                                     
         USE &DR&F10 INDE &DR&F10                                                                                                                                                                                                                         
         SEEK KDTEMP                                                                                                                                                                                                                                      
         IF .NOT. EOF()                                                                                                                                                                                                                                   
           IF REC_LOCK(0)                                                                                                                                                                                                                                 
              REPL ST_ACT_TOT WITH ST_ACT_TOT-XTEM                                                                                                                                                                                                        
              REPL ST_ACT_BUY WITH INT(ST_ACT_TOT/BUY_SELL_R)                                                                                                                                                                                             
              REPL ST_ACT_SEL WITH ST_ACT_TOT-(ST_ACT_BUY*BUY_SELL_R)                                                                                                                                                                                     
           ENDIF                                                                                                                                                                                                                                          
           UNLOCK                                                                                                                                                                                                                                         
         ENDIF                                                                                                                                                                                                                                            
      ENDIF                                                                                                                                                                                                                                               
                                                                                                                                                                                                                                                          
      TOTPHR=TOTPHR+PAYTMP                                                                                                                                                                                                                                
      TOTALL=TOTALL+PAYTMP                                                                                                                                                                                                                                
      BR=BR+1                                                                                                                                                                                                                                             
      sele 3                                                                                                                                                                                                                                              
      SKIP                                                                                                                                                                                                                                                
   ENDDO                                                                                                                                                                                                                                                  
   IF !mstop                                                                                                                                                                                                                                              
      EJECT                                                                                                                                                                                                                                               
      loop                                                                                                                                                                                                                                                
   endif                                                                                                                                                                                                                                                  
   nvat=totphr*vat/100                                                                                                                                                                                                                                    
   gtotphr=totphr+nvat                                                                                                                                                                                                                                    
   grtotal=gtotmed+gtotphr                                                                                                                                                                                                                                
   DO SAYG WITH 46,70,totphr,'99,999.99','9,999,999'                                                                                                                                                                                                      
   @ 47,27 say vat                                                                                                                                                                                                                                        
   DO SAYG WITH 47,70,nvat,'99,999.99','9,999,999'                                                                                                                                                                                                        
   DO SAYG WITH 48,70,gtotphr,'99,999.99','9,999,999'                                                                                                                                                                                                     
   @ 49,63  SAY AEACURR                                                                                                                                                                                                                                   
   DO SAYG WITH 49,70,grtotal,'99,999.99','9,999,999'                                                                                                                                                                                                     
   @ 50,63  SAY AEABCUR                                                                                                                                                                                                                                   
   DO SAYG WITH 50,70,grtotlcd,'9,999,999','9,999,999'                                                                                                                                                                                                    
                                                                                                                                                                                                                                                          
                                                                                                                                                                                                                                                          
*   @ 52,10   SAY AEACURR                                                                                                                                                                                                                                 
*   DO SAYG WITH 52,14,TOTMED,'99,999.99','9,999,999'                                                                                                                                                                                                     
*   @ 52,38  SAY AEACURR                                                                                                                                                                                                                                  
*   DO SAYG WITH 52,44,TOTPHR,'99,999.99','9,999,999'                                                                                                                                                                                                     
*   @ 52,63  SAY AEACURR                                                                                                                                                                                                                                  
*   DO SAYG WITH 52,70,TOTALL,'99,999.99','9,999,999'                                                                                                                                                                                                     
*   IF PRTDIAG                                                                                                                                                                                                                                            
*      @ 54, 2 SAY 'Diagnosis : '+subs(DIAGNAME,1,35)                                                                                                                                                                                                     
*   ENDIF                                                                                                                                                                                                                                                 
*      @ 54,63  SAY AEABCUR                                                                                                                                                                                                                               
*      DO SAYG WITH 54,70,OTAMO,'9,999,999','9,999,999'                                                                                                                                                                                                   
                                                                                                                                                                                                                                                          
*   IF TOTALL = 0                                                                                                                                                                                                                                         
*      IF HEALTH=.T.                                                                                                                                                                                                                                      
*         @ 56, 25  SAY "P. P R O G R A M   F O R M"                                                                                                                                                                                                      
*	 do decl_med                                                                                                                                                                                                                                            
*         @ 62,2  SAY "The cost of this treatment is entirely borne by P.PROGRAM, a prepaid"                                                                                                                                                              
*         @ 63,2  SAY "medical care program offered by "+alltrim(aeaname)                                                                                                                                                                                 
*	 do foot_inv                                                                                                                                                                                                                                            
*      ENDIF                                                                                                                                                                                                                                              
*      IF PILC=9                                                                                                                                                                                                                                          
*         @ 56, 25  SAY " N O   C H A R G E   F O R M "                                                                                                                                                                                                   
*         do decl_med                                                                                                                                                                                                                                     
*         @ 62,2  SAY "The cost of this treatment is entirely borne by"                                                                                                                                                                                   
*         @ 62,2  say alltrim(aeaname)+"."                                                                                                                                                                                                                
*         do foot_inv                                                                                                                                                                                                                                     
*      endif                                                                                                                                                                                                                                              
*   ELSE                                                                                                                                                                                                                                                  
*      if PILC=3                                                                                                                                                                                                                                          
*         @ 56,25  SAY "P A Y M E N T   R E C E I P T"                                                                                                                                                                                                    
*         do decl_med                                                                                                                                                                                                                                     
*         IF PL19=2 .OR. PAYMODE='CARD'                                                                                                                                                                                                                   
*            @ 60,2 SAY "Paid, the sum of : "+OTCUR+' ' +trans(otamo,'##,###,###')+' ('+aeacurr+' '+trans(totall,'##,###.##')+') '+'by : '+paymode                                                                                                        
*         else                                                                                                                                                                                                                                            
*            @ 60,2  say "Paid, the sum of : "+AEACURR                                                                                                                                                                                                    
*            DO SAYG WITH 60,25,TOTALL,'999,999.99','99,999,999'                                                                                                                                                                                          
*            @ 60,37 say 'by : '+paymode                                                                                                                                                                                                                  
*         ENDIF                                                                                                                                                                                                                                           
*                                                                                                                                                                                                                                                         
*         do foot_inv                                                                                                                                                                                                                                     
*      else                                                                                                                                                                                                                                               
*         if pilc=7                                                                                                                                                                                                                                       
*            @ 56,25  SAY "C R E D I T   V O U C H E R"                                                                                                                                                                                                   
*            @ 58,10  SAY RTRIM(FNMPAT)+' '+NMPAT + ', Dependant of '+depper                                                                                                                                                                              
*            @ 59,58  SAY subs(dtoc(DATE()),1,2) + ' ' + subs(dtoc(DATE()),4,2) + ' ' + subs(dtoc(DATE()),7,4)                                                                                                                                            
*            @ 64, 3  SAY "Send Invoice to : "+alltrim(aeaname)+" Tel :"+alltrim(atelp)                                                                                                                                                                   
*            @ 66, 3  SAY "to the attention of : Personnel Department"                                                                                                                                                                                    
*            do foot_inv                                                                                                                                                                                                                                  
*         else                                                                                                                                                                                                                                            
*            @ 56,26  SAY "C R E D I T   V O U C H E R"                                                                                                                                                                                                   
*	    do decl_med                                                                                                                                                                                                                                         
*            DO CASE                                                                                                                                                                                                                                      
*               CASE PILC=2                                                                                                                                                                                                                               
*                                                                                                                                                                                                                                                         
*                 IF PL19=2                                                                                                                                                                                                                               
*                    @ 60,2 say "Paid, the sum of : "+otcur+' '+trans(partothe,'##,###,###')+' ('+aeacurr+' '+trans(partcash,'##,###.##')+' by :'+paymode                                                                                                 
*                 ELSE                                                                                                                                                                                                                                    
*                    @ 60,2 say "Paid, the sum of : "+AEACURR                                                                                                                                                                                             
*                    DO SAYG WITH 60,25,PARTCASH,'999,999.99','99,999,999'                                                                                                                                                                                
*                    @ 60,37 say 'by : '+paymode                                                                                                                                                                                                          
*                 ENDIF                                                                                                                                                                                                                                   
*                 @ 60, 2  SAY "The balance payable to the Clinic for this treatment is : "+AEACURR                                                                                                                                                       
*                 DO SAYG WITH 61,67,PARTCRED,'999,999.99','99,999,999'                                                                                                                                                                                   
*               CASE PILC=4                                                                                                                                                                                                                               
*                 @ 60,2 SAY "Your P.PROGRAM renewal has not been processed, yet"                                                                                                                                                                         
*                 @ 61,2 SAY "The amount payable to the Clinic for this treatment is  : "+AEACURR                                                                                                                                                         
*                 DO SAYG WITH 61,66,TOTALL,'999,999.99','99,999,999'                                                                                                                                                                                     
*               OTHER                                                                                                                                                                                                                                     
*                 IF AUTHOR<>SPACE(16)                                                                                                                                                                                                                    
*                    @ 60,2 SAY "CREDIT AUTHORIZED BY : "+AUTHOR PICT "@!"                                                                                                                                                                                
*                 ENDIF                                                                                                                                                                                                                                   
*                 @ 61,2  SAY "The amount payable to the Clinic for this treatment is  : "+AEACURR                                                                                                                                                        
*                 DO SAYG WITH 61,66,TOTALL,'999,999.99','99,999,999'                                                                                                                                                                                     
*            ENDCASE                                                                                                                                                                                                                                      
*            @  62,2  SAY "Invoice to : _____________________________________ Tel : ________________"                                                                                                                                                     
*            @  63,2  SAY "Company : _______________________________________________________________"                                                                                                                                                     
*            @  64,2  SAY "Address : _______________________________________________________________"                                                                                                                                                     
*            @  65,2  say "          ________________________________________ Tel : ________________"                                                                                                                                                     
*            @  66,2  SAY "to the attention of : ________________________(Name of Authorized Person)"                                                                                                                                                     
*            do foot_inv                                                                                                                                                                                                                                  
*         endif                                                                                                                                                                                                                                           
*      ENDIF                                                                                                                                                                                                                                              
*   ENDIF                                                                                                                                                                                                                                                 
ENDDO                                                                                                                                                                                                                                                     
EJECT                                                                                                                                                                                                                                                     
SET DEVI TO SCREE                                                                                                                                                                                                                                         
                                                                                                                                                                                                                                                          
                                                                                                                                                                                                                                                          
Procedure decl_med                                                                                                                                                                                                                                        
*-----------------                                                                                                                                                                                                                                        
*@ 52, 2 SAY 'I,Mr/Ms ' + RTRIM(FNMPAT)+' '+NMPAT + ' have received MEDICAL TREATMENT'                                                                                                                                                                    
*@ 53, 2 SAY 'at the '+alltrim(aeaname)+' on '+subs(dtoc(DATE()),1,2) + '/' + subs(dtoc(DATE()),4,2) + '/' + subs(dtoc(DATE()),7,4)                                                                                                                       
@ 58,10 SAY RTRIM(FNMPAT)+' ' +NMPAT                                                                                                                                                                                                                      
@ 59,59 SAY subs(dtoc(DATE()),1,2)                                                                                                                                                                                                                        
@ 59,62 SAY subs(dtoc(DATE()),4,2)                                                                                                                                                                                                                        
@ 59,65 SAY subs(dtoc(DATE()),7,4)                                                                                                                                                                                                                        
                                                                                                                                                                                                                                                          
                                                                                                                                                                                                                                                          
Procedure foot_inv                                                                                                                                                                                                                                        
*-----------------                                                                                                                                                                                                                                        
@ 67,10 SAY subs(dtoc(DATE()),1,2)                                                                                                                                                                                                                        
@ 67,13 SAY subs(dtoc(DATE()),4,2)                                                                                                                                                                                                                        
@ 67,16 SAY subs(dtoc(DATE()),7,4)                                                                                                                                                                                                                        
                                                                                                                                                                                                                                                          
                                                                                                                                                                                                                                                          
Procedure Heading1                                                                                                                                                                                                                                        
*----------------                                                                                                                                                                                                                                         
BR=15                                                                                                                                                                                                                                                     
page=page+1                                                                                                                                                                                                                                               
*@ 5,  2 SAY ALLTRIM(USERNM)+'-'+KPIX                                                                                                                                                                                                                     
@ 4,66 SAY  a+'/'+str(MONTH(DATE()),2)+'/'+NOFT                                                                                                                                                                                                           
@ 6, 2 SAY DATE()                                                                                                                                                                                                                                         
@ 6,73 say 'PAGE: ' + str(page,1) + '/' + str(tot_pg,1)                                                                                                                                                                                                   
@ 7, 2 SAY TIME()                                                                                                                                                                                                                                         
@ 7,59  SAY KDPAT                                                                                                                                                                                                                                         
@  9, 11  SAY NMPAT                                                                                                                                                                                                                                       
@  9, 40  SAY FNMPAT                                                                                                                                                                                                                                      
@  9, 70  SAY MNMPAT                                                                                                                                                                                                                                      
@  10,15  SAY subs(dtoc(DOBPAT),1,2)                                                                                                                                                                                                                      
@  10,18  SAY subs(dtoc(DOBPAT),4,2)                                                                                                                                                                                                                      
@  10,21  SAY subs(dtoc(DOBPAT),7,4)                                                                                                                                                                                                                      
@  10, 40  SAY NATIO                                                                                                                                                                                                                                      
@  10, 70  SAY ISEX                                                                                                                                                                                                                                       
                                                                                                                                                                                                                                                          
Procedure HEADING                                                                                                                                                                                                                                         
*----------------                                                                                                                                                                                                                                         
                                                                                                                                                                                                                                                          
page=page+1                                                                                                                                                                                                                                               
@  2, 66  SAY  a+'/'+str(MONTH(DATE()),2)+'/'+NOFT                                                                                                                                                                                                        
@  3, 73  SAY str(page,1) + '/' + str(tot_pg,1)                                                                                                                                                                                                           
@  4, 12  SAY DATE()                                                                                                                                                                                                                                      
@  5, 12  SAY TIME()                                                                                                                                                                                                                                      
@  7, 70  SAY KDPAT                                                                                                                                                                                                                                       
@  7, 12  SAY NMPAT                                                                                                                                                                                                                                       
@  7, 40  SAY FNMPAT                                                                                                                                                                                                                                      
                                                                                                                                                                                                                                                          
age=round((date()-dobpat)/365,0)                                                                                                                                                                                                                          
                                                                                                                                                                                                                                                          
@  8, 12  SAY age                                                                                                                                                                                                                                         
@  8, 40  SAY NATIO                                                                                                                                                                                                                                       
@  8, 70  SAY ISEX                                                                                                                                                                                                                                        
                                                                                                                                                                                                                                                          
@ 9, 27 say paymode                                                                                                                                                                                                                                       
